C     Program EX_0701.FOR
C     Listing 14F - see documentation in TUTOR.SSS
 
$include:'SSSF1.H'
 
      subroutine prime
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server, ORD1, ORD2, DELUX1, DELUX2
      real*8 ORDNRY, DELUX
      common ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server(2), ORD1, ORD2, DELUX1, DELUX2
 
      do 1 i = 1, 2
  1     server(i) = 1
      ARRIVL = 1
      STARTA = 2
      ENDACT = 3
      NEXTAC = 4
      ORD1   = 1
      ORD2   = 2
      DELUX1 = 3
      DELUX2 = 4

      call INIQUE(5, 3, 1)
      call inista(1,'Interrupts           ', 0, 0, 0, 0)
      call SIMEND(60.0)
      call CREATE(0.0, 0)
      return
      end

      integer function sindex
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server, ORD1, ORD2, DELUX1, DELUX2
      real*8 ORDNRY, DELUX
      common ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server(2), ORD1, ORD2, DELUX1, DELUX2
 
      if (IDE().lt.DELUX1) then
        sindex = IDE()
      else
        sindex = IDE() - ORD2
      endif
      return
      end
 
      integer function shortr
$include:'SSSF2.H'
 
      if (NQ(4) + NQ(2).lt.NQ(3) + NQ(1))
     +  call SETIDE(IDE() + 1)
      shortr = IDE()
      return
      end
 
      subroutine preemp
$include:'SSSF2.H'

      integer ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server, ORD1, ORD2, DELUX1, DELUX2
      real*8 ORDNRY, DELUX
      common ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server(2), ORD1, ORD2, DELUX1, DELUX2
      integer preide, shortr
      real*8 remt
 
      call QUEUE(5, 0.0)
  99  continue
      if ((i.le.NC()).and.
     +  ((AIC(i, 3).eq.DELUX).or.(NEIC(i).ne.ENDACT)))
     +  then
        i = i + 1
        goto 99
      endif
 
      if (i.le.NC()) then
        remt = TIC(i) - T()
        call REMVFC(i)
        preide = IDE()
        call SETA(1, A(1) + 1)
        call SETA(2, remt)
        call SETQDC(1, 'LIFO    ')
        call QUEUE(IDE(), 0.0)
        call SETQDC(1, 'FIFO    ')
        call REMVFQ(5, 1)
        call SCHED(0.0, STARTA, preide + 2)
 
      else
        call REMVFQ(5, 1)
        call QUEUE(shortr(), 0)
      endif
      return
      end
 
      Program EX_0701
$include:'SSSF2.H'
      integer ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server, ORD1, ORD2, DELUX1, DELUX2
      real*8 ORDNRY, DELUX
      common ARRIVL, STARTA, ENDACT, NEXTAC,
     +  server(2), ORD1, ORD2, DELUX1, DELUX2
      integer s, ecode, sindex, shortr
 
      call prime
 
 
   99 ecode = NEXTEV()
      if (ecode.gt.0) then
        goto (101, 102, 103, 104) ecode
 
C ARRIVL
  101   continue
        call CREATE(EX(2.0), 0)
        call SETA(1, 0.0)
        call SETA(2, TR(1.0, 2.0, 3.0))
 
        if (RA().lt.0.25) then
          call SETIDE(DELUX1)
        else
          call SETIDE(ORD1)
        endif
        call SCHED(0.0, NEXTAC, IDE())
        goto 99
 
C NEXTAC
  104   continue
        if (server(1).gt.0) then
          call SCHED(0.0, STARTA, IDE())
        elseif (server(2).gt.0) then
          call  SCHED(0.0, STARTA, IDE()+1)
        elseif (IDE().eq.DELUX1) then
          call preemp()
        else
          call QUEUE(shortr(), 0.0)
        endif
        goto 99
 
C STARTA
  102   continue
        s = sindex()
        server(s) = server(s) - 1
        call SCHED(A(2), ENDACT, IDE())
        goto 99
 
C ENDACT
  103   continue
        s = sindex()
        server(s) = server(s) + 1
        if (IDE().lt.DELUX1) call TALLY(1, A(1))
        call DISPOS
 
        if (NQ(s + 2).gt.0) then
          call REMVFQ(s + 2, 1)
          call SCHED(0, STARTA, IDE())
        elseif (NQ(s).gt.0) then
          call REMVFQ(s, 1)
          call SCHED(0, STARTA, IDE())
        endif
        goto 99
 
      else
 
        call SUMRY(' ')
        stop 'End of simulation'
 
      endif
      end
 